For more details, see Software and Package Versions.
Run drop down (top right of the
code pane) and click Run Allknit (top left of code
pane) and a file will be generated in docs/index.htmlInstall R packages if needed.
# Required packages
required_packages <- c(
"rmarkdown",
"bookdown",
"knitr",
"tidyverse",
"purrr",
"glue",
"lubridate",
"scales",
"patchwork",
"DiagrammeR",
"DiagrammeRsvg",
"webshot2",
"magick",
"rsvg",
"sf",
"tmap",
"ggspatial",
"prettymapr",
"units"
)
# Try to install packages if not installed
default_options <- options()
tryCatch(
{
# Disable interactivity
options(install.packages.compile.from.source = "always")
# Install package if not installed
for (package in required_packages) {
is_package_installed <- require(package, character.only = TRUE)
if (!is_package_installed) {
cat(paste0("Installing package: ", package, "\n"))
install.packages(package)
} else {
cat(paste0("Package already installed: ", package, "\n"))
}
}
},
error = function(cond) {
stop(cond)
},
finally = {
options(default_options) # reset interactivity
}
)Load R libraries.
Read data from the data folder.
Bikeways data with manually verified (Google Street View/Earth and Web Search) painted lanes and cycle tracks for Vancouver, Canada
# Read data
vancbike_raw <- read_sf("../data/vancouver-bikeways-2024-06-02.geojson")
# Get download date
vancbike_dldate <- ddesc %>% filter(
file == "vancouver-bikeways-2024-06-02.geojson"
) %>% pull(download_date)Only the first 1000 records are shown.
The data contains the following columns:
## Simple feature collection with 3666 features and 22 fields
## Geometry type: LINESTRING
## Dimension: XY
## Bounding box: xmin: -123.2238 ymin: 49.19899 xmax: -123.0233 ymax: 49.31428
## Geodetic CRS: WGS 84
## # A tibble: 3,666 × 23
## id street status road_type road_type_recode install_year install_type
## <chr> <chr> <chr> <chr> <chr> <dbl> <chr>
## 1 294725 Highbury Active Resident… Local 2006 Local Street
## 2 294726 Highbury Active Resident… Local 2006 Local Street
## 3 294731 W 8th Ave Active Resident… Local 1994 Local Street
## 4 294732 W 8th Ave Active Resident… Local 1994 Local Street
## 5 294733 Off Street Active Lane Local 2003 Protected B…
## 6 294736 W 5th Ave Active Resident… Local 2009 Local Street
## 7 294737 W 8th Ave Active Resident… Local 1994 Local Street
## 8 294738 W 7th Ave Active Resident… Local 1994 Local Street
## 9 294739 W 7th Ave Active Resident… Local 1994 Local Street
## 10 294742 W 7th Ave Active Resident… Local 1994 Local Street
## # ℹ 3,656 more rows
## # ℹ 16 more variables: verify_install_year <dbl>, verify_install_date <chr>,
## # verify_install_type <chr>, verify_install_comment <chr>,
## # verify_upgrade1_year <dbl>, verify_upgrade1_date <chr>,
## # verify_upgrade1_type <chr>, verify_upgrade1_comment <chr>,
## # verify_upgrade2_year <dbl>, verify_upgrade2_date <chr>,
## # verify_upgrade2_type <chr>, verify_upgrade2_comment <chr>, …
The data files are available below:
Bikeways data with manually verified (Google Street View/Earth and Web Search) painted lanes and cycle tracks for Calgary, Canada
# Read data
calgbike_raw <- read_sf("../data/calgary-bikeways-2024-06-05.geojson")
# Get download date
calgbike_dldate <- ddesc %>% filter(
file == "calgary-bikeways-2024-06-05.geojson"
) %>% pull(download_date)Only the first 1000 records are shown.
The data contains the following columns:
## Simple feature collection with 4169 features and 21 fields
## Geometry type: MULTILINESTRING
## Dimension: XY
## Bounding box: xmin: -114.269 ymin: 50.89762 xmax: -113.9302 ymax: 51.17778
## Geodetic CRS: WGS 84
## # A tibble: 4,169 × 22
## id street status road_type road_type_recode install_year install_type
## <chr> <chr> <chr> <chr> <chr> <dbl> <chr>
## 1 1 <NA> EXISTING <NA> <NA> 2003 On-Street Bike…
## 2 2 <NA> EXISTING <NA> <NA> 2009 On-Street Bike…
## 3 3 <NA> EXISTING <NA> <NA> 2009 On-Street Bike…
## 4 4 <NA> EXISTING <NA> <NA> 1999 On-Street Bike…
## 5 5 <NA> EXISTING <NA> <NA> 1999 On-Street Bike…
## 6 6 <NA> EXISTING <NA> <NA> 2005 On-Street Bike…
## 7 7 <NA> EXISTING <NA> <NA> 1999 On-Street Bike…
## 8 8 <NA> EXISTING <NA> <NA> 1999 On-Street Bike…
## 9 9 <NA> EXISTING <NA> <NA> 1999 On-Street Bike…
## 10 10 <NA> INACTIVE <NA> <NA> NA DECOMMISSIONED
## # ℹ 4,159 more rows
## # ℹ 15 more variables: verify_install_year <dbl>, verify_install_date <chr>,
## # verify_install_type <chr>, verify_install_comment <chr>,
## # verify_upgrade1_year <dbl>, verify_upgrade1_date <chr>,
## # verify_upgrade1_type <chr>, verify_upgrade1_comment <chr>,
## # verify_upgrade2_year <dbl>, verify_upgrade2_date <chr>,
## # verify_upgrade2_type <chr>, verify_upgrade2_comment <chr>, …
The data files are available below:
Bikeways data with manually verified (Google Street View/Earth and Web Search) painted lanes and cycle tracks for Toronto, Canada
# Read data
toronbike_raw <- read_sf("../data/toronto-bikeways-2024-06-02.geojson")
# Get download date
toronbike_dldate <- ddesc %>% filter(
file == "toronto-bikeways-2024-06-02.geojson"
) %>% pull(download_date)Only the first 1000 records are shown.
The data contains the following columns:
## Simple feature collection with 1323 features and 22 fields
## Geometry type: MULTILINESTRING
## Dimension: XY
## Bounding box: xmin: -79.63039 ymin: 43.58221 xmax: -79.11803 ymax: 43.85546
## Geodetic CRS: WGS 84
## # A tibble: 1,323 × 23
## id street street_from street_to road_type road_type_recode install_year
## <chr> <chr> <chr> <chr> <chr> <chr> <dbl>
## 1 8 Bloor St… Parliament… Castle F… Major Ar… Arterial 2001
## 2 17 Lake Sho… Humber Bay… Humber B… Major Ar… Arterial 2001
## 3 18 Lake Sho… 37 M E Fle… Humber B… Major Ar… Arterial 2001
## 4 19 Lake Sho… 50.7 M E L… 37 M E F… Major Ar… Arterial 2001
## 5 38 Queens Q… Martin Goo… Bathurst… Collector Collector 2001
## 6 39 Davenpor… Cottingham… Macphers… Minor Ar… Arterial 2001
## 7 40 Elizabet… College St Gerrard … Collector Collector 2001
## 8 41 Gerrard … Yonge St Church St Minor Ar… Arterial 2001
## 9 42 Macphers… Davenport … Poplar P… Collector Collector 2001
## 10 43 Lake Sho… Marine Par… Palace P… Major Ar… Arterial 2001
## # ℹ 1,313 more rows
## # ℹ 16 more variables: install_type <chr>, verify_install_year <dbl>,
## # verify_install_date <chr>, verify_install_type <chr>,
## # verify_install_comment <chr>, verify_upgrade1_year <dbl>,
## # verify_upgrade1_date <chr>, verify_upgrade1_type <chr>,
## # verify_upgrade1_comment <chr>, verify_upgrade2_year <dbl>,
## # verify_upgrade2_date <chr>, verify_upgrade2_type <chr>, …
The data files are available below:
The verification dates manually entered for the cycling infrastructure data were unstructured and do not follow a structured format suitable for analysis.
Nevan Opp nevanopp@cmail.carleton.ca went through the dates in Google Sheets, interpreted them, and formatted them into structured dates, while Richard Wen richard.wen@utoronto.ca updated and fixed errors as needed.
These structured dates can then be joined back to the unstructured dates to include higher resolution temporal data to the cycling infrastructure install and upgrade dates.
# Read data
vdates_raw <- read_csv("../data/verify-dates-2024-06-12.csv")
# Get download date
vdates_dldate <- ddesc %>% filter(
file == "verify-dates-2024-06-12.csv"
) %>% pull(download_date)The data contains the following columns:
The data files are available below:
KSI (1980-2024) data from the City of Toronto (David McElroy David.McElroy@toronto.ca) for Toronto, Ontario
# Read data
toronksi_raw <- read_sf(
"../data/toronto-ksi-2024-06-13.csv",
options = c(
"X_POSSIBLE_NAMES=LONGITUDE",
"Y_POSSIBLE_NAMES=LATITUDE"
),
crs = 4326
)
# Get download date
toronksi_dldate <- ddesc %>% filter(
file == "toronto-ksi-2024-06-13.csv"
) %>% pull(download_date)Note: Due to the large number of records, only the latest year of 2024 is displayed (n = 239).
The data contains the following columns:
## Simple feature collection with 67462 features and 50 fields
## Geometry type: POINT
## Dimension: XY
## Bounding box: xmin: -79.63925 ymin: 43.58964 xmax: -79.12297 ymax: 43.85544
## Geodetic CRS: WGS 84
## # A tibble: 67,462 × 51
## INDEX ACCNUM YEAR DATE TIME STREET1 STREET2 OFFSET ROAD_CLASS DISTRICT
## * <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
## 1 3738192 999991 1980 1980-0… 330 MARKHA… MILNER… "" Major Art… Scarbor…
## 2 3738193 999991 1980 1980-0… 330 MARKHA… MILNER… "" Major Art… Scarbor…
## 3 75100 30 1985 1985-0… 300 ALBION… EDGEBR… "" Major Art… Etobico…
## 4 75101 30 1985 1985-0… 300 ALBION… EDGEBR… "" Major Art… Etobico…
## 5 75102 30 1985 1985-0… 300 ALBION… EDGEBR… "" Major Art… Etobico…
## 6 75863 1094 1985 1985-0… 1100 STEELE… STEINW… "" Major Art… Etobico…
## 7 75864 1094 1985 1985-0… 1100 STEELE… STEINW… "" Major Art… Etobico…
## 8 75865 1094 1985 1985-0… 1100 STEELE… STEINW… "" Major Art… Etobico…
## 9 75866 1094 1985 1985-0… 1100 STEELE… STEINW… "" Major Art… Etobico…
## 10 75154 143 1985 1985-0… 2000 MORNIN… SHEPPA… "" Major Art… Scarbor…
## # ℹ 67,452 more rows
## # ℹ 41 more variables: WARDNUM <chr>, DIVISION <chr>, LATITUDE <dbl>,
## # LONGITUDE <dbl>, LOCCOORD <chr>, ACCLOC <chr>, TRAFFCTL <chr>,
## # VISIBILITY <chr>, LIGHT <chr>, RDSFCOND <chr>, ACCLASS <chr>,
## # IMPACTYPE <chr>, INVTYPE <chr>, INVAGE <chr>, INJURY <chr>, FATAL_NO <chr>,
## # INITDIR <chr>, VEHTYPE <chr>, MANOEUVER <chr>, DRIVACT <chr>,
## # DRIVCOND <chr>, PEDTYPE <chr>, PEDACT <chr>, PEDCOND <chr>, …
The data files are available below:
Combine bikeway data across all cities.
# List of city bikeway data
bike_list <- list(
vancouver = vancbike_raw,
calgary = calgbike_raw %>%
mutate(no_verify_install_type = NA),
toronto = toronbike_raw %>%
mutate(no_verify_install_type = NA)
)
# Get common columns across all city bikeways
bike_cols <- bike_list %>%
map(colnames) %>%
reduce(intersect)
# Combine bikeway data across cities
bike_raw <- names(bike_list) %>%
map(function(city) {
bike_list[[city]] %>%
select(
all_of(bike_cols)
) %>%
mutate(
city = factor(city, levels = names(bike_list)),
.before = 1
)
}) %>%
reduce(add_row)
# Display combined bikeway data
bike_raw %>% as_tibbleCombine KSI data across cities and standardize columns.
Note: Only Toronto KSI is included for now.
Pivot bikeways data to long format, where each record represents an installation or upgrade.
Also adds the following columns:
_pivot_type: one of install,
upgrade1, or upgrade2_pivot_year: the year of the install or upgrade from
verify_install_year, verify_upgrade1_year, or
verify_upgrade2_year# Pivot to long format on installs and upgrades
bike <- bike_raw %>%
pivot_longer(
cols = c(
verify_install_date,
verify_upgrade1_date,
verify_upgrade2_date
),
names_to = "_pivot_column",
values_to = "_pivot_value"
) %>%
mutate(
`_pivot_type` = case_when(
str_starts(`_pivot_column`, "verify_install") ~ "install",
str_starts(`_pivot_column`, "verify_upgrade1") ~ "upgrade1",
str_starts(`_pivot_column`, "verify_upgrade2") ~ "upgrade2"
),
`_pivot_year` = case_when(
`_pivot_type` == "install" ~ verify_install_year,
`_pivot_type` == "upgrade1" ~ verify_upgrade1_year,
`_pivot_type` == "upgrade2" ~ verify_upgrade2_year
)
)
# Display pivot columns
bike %>%
as_tibble %>%
select(
`_pivot_type`,
`_pivot_year`,
`_pivot_column`,
`_pivot_value`,
everything()
) %>%
arrange(`_pivot_year`)Join ambiguous verified install/upgrade dates (e.g. Jan 1/2022, 2022/02, Fall 2020) to manually cleaned dates with structured time units (e.g. days, months, quarters, semesters, ranges) and date formats (e.g. 2022-01-01, 2022-02-01).
The following cleaned structured date columns will be added to bikeways:
# Join clean dates to include structured date formats
bike <- bike %>%
left_join(
vdates_raw,
by = join_by(`_pivot_value` == verify_date_raw)
)
# Display clean dates cols
bike %>%
as_tibble %>%
select(all_of(
colnames(vdates_raw) %>%
.[. != "verify_date_raw"]
)) %>%
arrange(verify_date_type)Add the following time unit columns for installs/upgrades in bikeways and ksi:
_time_month: which month (1, 2, 3 … 12) a bikeway had a
verified installation/upgrade_time_quarter: which quarter (1, 2, 3, 4) of the year a
bikeway had a verified installation/upgrade_time_third: which third (1, 2, 3) of the year a
bikeway had a verified installation/upgrade_time_half: which half (1, 2) of the year a bikeway had
a verified installation/upgrade_time_semester: which semester (1, 2) of the year a
bikeway had a verified installation/upgrade, where:
1: represents November to April of next year2: represents May to October of next yearNote: Date ranges that fall between months, quarters, thirds, or halves of the year were excluded from being classified as any of the time units (e.g. March 31 to April 15 will be excluded as it does not fall within either the 1st or 2nd quarter of the year).
#' Add Time Units to Data Frame
#'
#' This function takes a data frame and adds new columns representing various time units such as month, quarter, third, half, and semester. These columns are derived from a date column or if the time unit is more than day, then additiona start and end date columns
#'
#' @param df A data frame that contains the columns `verify_date`, `verify_date_type`, `verify_date_start`, and `verify_date_end`.
#' @param date_col Name of the date column to use
#' @param start_col Name of the start date column to use
#' @param end_col Name of the end date column to use
#' @param type_col Name of the date type column to use (e.g. month, day, year, etc)
#'
#' @return A data frame with additional columns:
#' \describe{
#' \item{`_time_month`}{Numeric representation of the month (1-12).}
#' \item{`_time_quarter`}{Quarter of the year (1-4).}
#' \item{`_time_third`}{Third of the year (1-3).}
#' \item{`_time_half`}{Half of the year (1-2).}
#' \item{`_time_semester`}{Custom semester (1 for May-Oct, 2 for Nov-Apr).}
#' }
#'
#' @examples
#' \dontrun{
#' df <- data.frame(
#' verify_date = as.Date(c("2021-01-15", "2021-06-20", "2021-09-10")),
#' verify_date_type = c("day", "month", "day"),
#' verify_date_start = as.Date(c("2021-01-01", "2021-06-01", "2021-09-01")),
#' verify_date_end = as.Date(c("2021-01-31", "2021-06-30", "2021-09-30"))
#' )
#' result <- add_time_units(df)
#' print(result)
#' }
#'
#' @import dplyr
#' @importFrom lubridate month year
#' @export
add_time_units <- function(
df,
date_col = "verify_date",
start_col = "verify_date_start",
end_col = "verify_date_end",
type_col = "verify_date_type"
) {
df %>%
rename( # rename req cols
`_date` := !!sym(date_col),
`_start` := !!sym(start_col),
`_end` := !!sym(end_col),
`_type` := !!sym(type_col)
) %>%
mutate( # add time units
# Months (monthly)
`_time_month` = case_when(
`_type` %in% c("day", "month") ~ month(`_date`, label = T, abbr = F)
),
`_time_month` = as.numeric(`_time_month`),
# Quarters (quarterly)
`_time_quarter` = case_when(
month(`_date`) %in% 1:3 |
(
month(`_start`) %in% 1:3 &
month(`_end`) %in% 1:3 &
year(`_start`) == year(`_end`)
) ~ 1,
month(`_date`) %in% 4:6 |
(
month(`_start`) %in% 4:6 &
month(`_end`) %in% 4:6 &
year(`_start`) == year(`_end`)
) ~ 2,
month(`_date`) %in% 7:9 |
(
month(`_start`) %in% 7:9 &
month(`_end`) %in% 7:9 &
year(`_start`) == year(`_end`)
) ~ 3,
month(`_date`) %in% 10:12 |
(
month(`_start`) %in% 10:12 &
month(`_end`) %in% 10:12 &
year(`_start`) == year(`_end`)
) ~ 4
),
# Thirds (triyearly)
`_time_third` = case_when(
month(`_date`) %in% 1:4 |
(
month(`_start`) %in% 1:4 &
month(`_end`) %in% 1:4 &
year(`_start`) == year(`_end`)
) ~ 1, # Fall
month(`_date`) %in% 5:8 |
(
month(`_start`) %in% 5:8 &
month(`_end`) %in% 5:8 &
year(`_start`) == year(`_end`)
) ~ 2, # Winter
month(`_date`) %in% 9:12 |
(
month(`_start`) %in% 9:12 &
month(`_end`) %in% 9:12 &
year(`_start`) == year(`_end`)
) ~ 3 # Spring/Summer
),
# Halves (biyearly)
`_time_half` = case_when(
month(`_date`) %in% 1:6 |
(
month(`_start`) %in% 1:6 &
month(`_end`) %in% 1:6 &
year(`_start`) == year(`_end`)
) ~ 1,
month(`_date`) %in% 7:12 |
(
month(`_start`) %in% 7:12 &
month(`_end`) %in% 7:12 &
year(`_start`) == year(`_end`)
) ~ 2
),
# Semester (custom range)
`_time_semester` = case_when(
month(`_date`) %in% c(11:12, 1:4) |
(
month(`_start`) %in% c(11:12, 1:4) &
( # Nov to Dec of this year
month(`_end`) %in% 11:12 &
year(`_end`) == year(`_start`)
) |
( # Jan to Apr of this or next year
month(`_end`) %in% 1:4 &
year(`_end`) == year(`_start`) |
year(`_end`) == (year(`_start`) + 1)
)
) ~ 2, # Nov to Apr of next year
month(`_date`) %in% 5:10 |
(
month(`_start`) %in% 5:10 &
month(`_end`) %in% 5:10 &
year(`_start`) == year(`_end`)
) ~ 1 # May to Oct
)
) %>%
rename( # rename back to orig
!!date_col := `_date`,
!!start_col := `_start`,
!!end_col := `_end`,
!!type_col := `_type`
)
}
# Add time unit columns using func for bikeways
bike <- bike %>% add_time_units
# Add time unit columns using func for ksi
ksi <- ksi %>%
mutate( # add cols to standardize func params
verify_date = ksi_date,
verify_date_start = NA,
verify_date_end = NA,
verify_date_type = "day"
) %>%
add_time_units %>%
select( # remove no longer needed cols
-verify_date,
-verify_date_start,
-verify_date_end,
-verify_date_type
)Filter for bikeways and KSI with a verified installation or upgrade after 2011.
# Filter bikeways for post2011
bike <- bike %>%
filter(`_pivot_year` > 2011)
# Filter ksi for post2011
ksi <- ksi %>%
filter(year(ksi_date) > 2011)For bikeways, determine the temporal resolution (unit of time) finer than yearly based on the amount of data available per time unit (sorted from the highest resolution time unit to the lowest resolution time unit):
# Prepare plot data
unit_data <- bike %>%
as_tibble %>%
group_by(city) %>%
summarize( # calc installs/upgrades for each time unit
Month = sum(!is.na(`_time_month`)),
Quarter = sum(!is.na(`_time_quarter`)),
Third = sum(!is.na(`_time_third`)),
Half = sum(!is.na(`_time_half`)),
Semester = sum(!is.na(`_time_semester`))
) %>%
pivot_longer(
cols = -city,
names_to = "type",
values_to = "n"
) %>%
mutate( # zero as NA
n = if_else(n == 0, NA, n)
) %>%
left_join( # Add city totals
bike %>%
as_tibble %>%
group_by(city) %>%
count(name = "total"),
by = "city"
) %>%
ungroup %>%
mutate( # calc percentages and add labels
type = factor(type, levels = c("Month", "Quarter", "Third", "Half", "Semester")),
city = factor(str_to_title(city), levels = c("Vancouver", "Calgary", "Toronto")),
perc = n / total * 100,
perc_label = glue(
"{str_sub(city, end = 1)}: {round(perc, 2)}%\n",
"(n={format(n, big.mark = ',', scientific = F)})"
)
) %>%
group_by(type) %>% # adjust overlapping labels
arrange(desc(perc)) %>%
mutate( # detect overlap labels and shift down and up
perc_label_y = case_when(
lag(perc) - perc < 2 ~ perc - 1.5,
lead(perc) - perc > -2 ~ perc + 1.5,
.default = perc
)
) %>%
group_by(city) %>%
mutate( # add city labels at end of lines
city_label = if_else(
type == "Semester",
glue(
"{city}\n",
"(n={format(total, big.mark = ',', scientific = F)})"
),
NA
)
) %>%
ungroup %>%
arrange(city, type)
# Get total
unit_total <- sum(unit_data$total %>% unique, na.rm = T)
unit_total_label <- format(unit_total, big.mark = ",", scientific = F)
# Plot line
unit_plot <- unit_data %>%
ggplot(aes(
x = type,
y = perc,
group = city,
color = city,
label = perc_label
)) +
geom_line(
alpha = 0.8,
linewidth = 1.5
) +
geom_label(
aes(y = perc_label_y),
size = 2,
show.legend = F,
label.padding = unit(0.5, "lines")
) +
geom_text(
aes(
label = city_label,
y = perc_label_y
),
size = 2.25,
show.legend = F,
hjust = 0,
nudge_x = 0.25
) +
scale_y_continuous(labels = function(x) paste0(x, "%")) +
scale_x_discrete(
limits = levels(unit_data$type),
position = "top"
) +
labs(
title = glue(
"% of Verified Post-2011 Installs & Upgrades by Unit of Time\n",
"(n={unit_total_label})"
),
x = NULL,
y = NULL,
color = "City",
label = NULL,
group = NULL
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(hjust = 0.5)
)
unit_plot
Add a column _time_group that stores the spatiotemporal
grouping for both the ksi and bikeways.
# Assign spatiotemp group for bikeways
bike <- bike %>% mutate(
`_time_group` = if_else(
!is.na(`_time_semester`),
glue("Semester {`_time_semester`} {`_pivot_year`}"),
NA
)
)
# Assign spatiotemp group for ksi
ksi <- ksi %>% mutate(
`_time_group` = if_else(
!is.na(`_time_semester`),
glue("Semester {`_time_semester`} {year(ksi_date)}"),
NA
)
)Spatiotemporally join KSI to nearest bikeways based on the spatiotemporal groups.
Each KSI point is joined to a bikeway if they are:
Note: if there is overlapping of bikeways, the same KSI can be assigned to multiple bikeways.
# Set cache file for spatiotemp join
bike_nid_date <- max(c(
vancbike_dldate,
calgbike_dldate,
toronbike_dldate,
toronksi_dldate
))
bike_nid_file <- glue("../data/cache/bike-nid-{bike_nid_date}.csv")
# Spatial join ksi by spatiotemp group
if (!file.exists(bike_nid_file)) {
# Run spatial join if no up to date cache
bike_nid <- bike %>%
filter(!is.na(`_time_group`)) %>%
arrange(`_time_group`) %>%
group_by(`_time_group`) %>%
group_map(~ {
# Temporal filter by group
ksi_temp <- ksi %>%
filter(`_time_group` == .y$`_time_group`)
# Buffer 25 meters
bike_buff <- .x %>% st_buffer(25)
# Spatial join
ksi_temp %>%
st_join(bike_buff) %>%
select(
city,
id,
ksi_id
) %>%
as_tibble %>%
select(-geometry)
}, .keep = T) %>%
reduce(bind_rows)
# Cache spatiotemp join
bike_nid %>% write_csv(bike_nid_file)
} else {
# Read spatiotemp join from cache
bike_nid <- read_csv(bike_nid_file)
}
# Display ksi count per bikeway
bike_nid %>%
filter(!is.na(id)) %>%
group_by(id) %>%
summarize(ksi_count = n()) %>%
arrange(ksi_count)